home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / wprint.zip / WPRINT.INC < prev    next >
Text File  |  1987-12-05  |  4KB  |  90 lines
  1. 'WPRINT.INC Copyright (c) 1987 by Unique Software
  2. SUB Wprint(windo%,wcolor%,strng$,no.cr%) STATIC
  3. ' windo%   :  0=print to current active window
  4. '          : >0=print to specific window
  5. '          :    (in TBWINDO.INC this is the variable "li")
  6. ' wcolor%  : the foreground color for this string to be printed in
  7. '          :     the background color of the window is ALWAYS used
  8. ' strng$   : string you want to print
  9. ' no.cr%   :   0=do a <CR> after printing string
  10. '          : <>0=don't do a <CR> after printing sring
  11. '          : i.e. consider a non-zero value as a trailing ; in a PRINT stmt
  12. SHARED li , wrow() , wrows() , wcol() , wcols() , wccol() , wcrow()
  13. LOCAL wstr$ , wword$ , word.len% , row.max% , col.max% , row.min% , col.min%
  14. LOCAL cols% , rows% , exit.flag%
  15.  IF windo%<1 OR windo%>li THEN windo%=li
  16.  cols%=wcols(windo%)-2
  17. ' speed up things by not recalculating this value several times in this SUB
  18.  wstr$=strng$
  19.  word.len%=0
  20.  WHILE LEN(wstr$)>0
  21.      CALL Getword(word.len%,wstr$)
  22.      IF word.len%=0 THEN EXIT SUB
  23.      wword$=LEFT$(wstr$,word.len%) ' get word
  24.      wstr$=MID$(wstr$,word.len%+1) ' remove from string
  25.      IF ( word.len%+wccol(windo%)-1 ) > cols%  AND  word.len% > cols% THEN
  26. ' if the whole word is wider than the total width of the window then
  27.              wstr$=MID$(wword$,cols%-wccol(windo%)+2)+wstr$
  28. ' put the part of the word we won't use back to the working string
  29.              wword$=LEFT$(wword$,cols%-wccol(windo%)+1)
  30. ' get enough of the word to fill current line
  31.              word.len%=len(wword$)
  32. ' the new word length
  33.      END IF
  34.      IF ( word.len%+wccol(windo%)-1 ) > cols% THEN CALL Wscroll(windo%)
  35.      CALL WQPRINT(windo%,wcolor%,wword$)
  36.      IF wccol(windo%)>=cols% THEN CALL Wscroll(windo%) ' scroll position
  37.  WEND
  38.      IF no.cr%=0 THEN CALL Wscroll(windo%) ' scroll position
  39. END SUB
  40.  
  41. SUB Wqprint(windo%,wcolor%,word$)
  42. 'print word$ at current position and update
  43. SHARED wrow() , wcol() , wcrow() , wccol() , wattr() , li
  44. LOCAL tmp%
  45.  IF windo%<1 OR windo%>li THEN windo%=li
  46.  if asc(word$)=32 then
  47. ' if we have a single space & are at the start of a column then don't print it
  48.     if len(word$)=1 and wccol(windo%)=1 then exit sub
  49.  end if
  50.  if wcolor%=0 then
  51.     tmp%=wattr(windo%)
  52.  else
  53.     tmp%=16*(wattr(windo%)\16)+wcolor%
  54.  end if
  55.  CALL Qprint (wrow(windo%)+wcrow(windo%),wcol(windo%)+wccol(windo%),word$,tmp%)
  56.  INCR wccol(windo%),LEN(word$)
  57. END SUB
  58.  
  59. SUB Wscroll(windo%)
  60. 'windo%  :    0=active window (variable "li" in TBWINDO.INC)
  61. '        :  >li=active window
  62. SHARED wrow() , wcol() , wrows() , wcols() , wattr() , li , wcrow() , wccol()
  63.  IF windo%<1 OR windo%>li THEN windo%=li ' 0=current active window
  64.  wccol(windo%)=1
  65.  IF wcrow(windo%) < ( wrows(windo%)-2 ) THEN
  66.     INCR wcrow(windo%) ' increment current row
  67.     exit sub
  68.  END IF
  69.  REG 1,&H0601 ' scroll up : one line
  70.  REG 2,wattr(windo%)*256 ' windo%'s attribute to BH
  71.  REG 3,wrow(windo%)*256+wcol(windo%) ' starting row & column
  72. ' the video bios routine uses absolute (0:0) addressing and since we don't
  73. ' want to scroll the frame (relative 0:0) no adjustment is necessary
  74.  REG 4,( wrow(windo%)+wrows(windo%)-3 )*256+_ ' lower right row to DH
  75.      ( wcol(windo%)+wcols(windo%)-3 )       ' lower right col to DL
  76.  CALL INTERRUPT &H10 ' execute video bios routine
  77. END SUB
  78.  
  79. 'CALL getword (result%,string$)
  80. SUB Getword INLINE
  81. 'returns the length of the first word in string$
  82. 'where a word is a group of spaces OR a group of characters ending with a space
  83. $INLINE 085,137,229,006,030,196,126,006,038,139,013,129,225,255,127,131,249
  84. $INLINE 000,116,002,235,005,049,192,233,037,000,062,139,022,000,000,082,031
  85. $INLINE 038,139,117,002,065,030,007,137,247,176,032,038,138,037,128,252,032
  86. $INLINE 117,004,243,174,235,002,242,174,137,248,041,240,072,197,126,010,062
  87. $INLINE 137,005,031,007,093
  88. END SUB
  89. 
  90.